package JasPerl::RequestDispatcher;

use strict;
use warnings;

use constant {
    ERROR_EXCEPTION      => "javax.servlet.error.exception",
    ERROR_EXCEPTION_TYPE => "javax.servlet.error.exception_type",
    ERROR_MESSAGE        => "javax.servlet.error.message",
    ERROR_REQUEST_URI    => "javax.servlet.error.request_uri",
    ERROR_SERVLET_NAME   => "javax.servlet.error.servlet_name",
    ERROR_STATUS_CODE    => "javax.servlet.error.status_code",

    # FORWARD_CONTEXT_PATH => "javax.servlet.forward.context_path",
    # FORWARD_SERVLET_PATH => "javax.servlet.forward.servlet_path",

    FORWARD_SCRIPT_NAME  => "jasperl.forward.script_name",
    FORWARD_PATH_INFO    => "javax.servlet.forward.path_info",
    FORWARD_QUERY_STRING => "javax.servlet.forward.query_string",
    FORWARD_REQUEST_URI  => "javax.servlet.forward.request_uri",

    # INCLUDE_CONTEXT_PATH => "javax.servlet.include.context_path",
    # INCLUDE_SERVLET_PATH => "javax.servlet.include.servlet_path"

    INCLUDE_SCRIPT_NAME =>  "jasperl.include.script_name",
    INCLUDE_PATH_INFO    => "javax.servlet.include.path_info",
    INCLUDE_QUERY_STRING => "javax.servlet.include.query_string",
    INCLUDE_REQUEST_URI  => "javax.servlet.include.request_uri",
};

sub new {
    warn "### @_";
    my ($class, $service, $uri) = @_;
    bless { service => $service, uri => URI->new($uri) }, $class;
}

sub forward {
    my ($self, $request, $response) = @_;

    # if ($response->is_committed()) {
    #     # throw ise
    # }

    $response->reset_buffer(); # throws ise

    # Check SRV.8.2 / SRV.14.2.5.1 compliance
    # ??? do unwrap ???
    while ($request->isa('JasPerl::RequestWrapper')) {
        $request = $request->get_request();
    }

    if (my $uri = $self->{uri}) {
        my $wrequest = JasPerl::RequestDispatcher::RequestWrapper->new($request, { }, $uri);
        $wrequest->set_attribute(FORWARD_SCRIPT_NAME, $request->get_script_name());
        $wrequest->set_attribute(FORWARD_PATH_INFO, $request->get_path_info());
        $wrequest->set_attribute(FORWARD_QUERY_STRING, $request->get_query_string());
        $wrequest->set_attribute(FORWARD_REQUEST_URI, $request->get_request_uri());
        $self->{service}->service($wrequest, $response);
    } else {
        $self->{service}->service($request, $response);
    }
}

sub include {
    my ($self, $request, $response) = @_;
    # TODO: clear buffer, etc.
    my $wresponse = JasPerl::RequestDispatcher::IncludeResponseWrapper->new($self, $response);

    if (my $uri = $self->{uri}) {
        my $wrequest = JasPerl::RequestDispatcher::RequestWrapper->new($self, $request);
        $wrequest->set_attribute(INCLUDE_SCRIPT_NAME, $uri->path);
        $wrequest->set_attribute(INCLUDE_QUERY_STRING, $uri->query);
        $wrequest->set_attribute(INCLUDE_REQUEST_URI, $uri->path_query);
        $self->{service}->service($wrequest, $wresponse);
    } else {
        $self->{service}->service($request, $wresponse);
    }
}

package JasPerl::RequestDispatcher::RequestWrapper;

use parent qw(JasPerl::RequestWrapper);

use constant {
    REQUEST => 0,
    ATTRIBUTES => 1,
    URI => 2
};

my %DISPATCHER_ATTRIBUTES = map { $_ => 1 } (
    JasPerl::RequestDispatcher::FORWARD_SCRIPT_NAME,
    JasPerl::RequestDispatcher::FORWARD_PATH_INFO,
    JasPerl::RequestDispatcher::FORWARD_QUERY_STRING,
    JasPerl::RequestDispatcher::FORWARD_REQUEST_URI,
    JasPerl::RequestDispatcher::INCLUDE_SCRIPT_NAME,
    JasPerl::RequestDispatcher::INCLUDE_PATH_INFO,
    JasPerl::RequestDispatcher::INCLUDE_QUERY_STRING,
    JasPerl::RequestDispatcher::INCLUDE_REQUEST_URI
);

sub new {
    my ($class, $request, $attributes, $uri) = @_;
    bless [ $request, $attributes, $uri ], $class;
}

sub get_request {
    return $_[0]->[0];
}

# request attributes

sub get_attribute {
    my ($self, $name) = @_;
    return $self->[REQUEST]->get_attribute($name)
        unless exists $DISPATCHER_ATTRIBUTES{$name};
    return $self->[ATTRIBUTES]->{$name};
}

sub get_attribute_names {
    my $self = shift;
    my %names = map { $_ => 1 } $self->[REQUEST]->get_attribute_names()->list;
    delete @names{keys %DISPATCHER_ATTRIBUTES};
    %names = (%names, %{$self->[ATTRIBUTES]});
    return JasPerl::Util::Enumeration->from_list(keys %names);
}

sub set_attribute {
    my ($self, $name, $value) = @_;
    return $self->[REQUEST]->set_attribute($name, $value)
        unless exists $DISPATCHER_ATTRIBUTES{$name};
    if (defined $value) {
        $self->[ATTRIBUTES]->{$name} = $value;
    } else {
        delete $self->[ATTRIBUTES]->{$name};
    }
}

sub remove_attribute {
    my ($self, $name) = @_;
    return $self->[REQUEST]->remove_attribute($name)
        unless exists $DISPATCHER_ATTRIBUTES{$name};
    delete $self->[ATTRIBUTES]->{$name};
}

# request parameters

sub get_parameter {
    $_[0]->get_request()->get_parameter($_[1]);
}

sub get_parameter_names {
    $_[0]->get_request()->get_parameter_names();
}

sub get_parameter_values {
    $_[0]->get_request()->get_parameter_values($_[1]);
}

sub get_parameter_map {
    $_[0]->get_request()->get_parameter_map();
}

# request uri components

sub get_script_name {
    my $self = shift;
    return $self->[REQUEST]->get_path_info()
        unless $self->[URI];
    return $self->[URI]->path;
}

sub get_path_info {
    my $self = shift;
    return $self->[REQUEST]->get_path_info()
        unless $self->[URI];
    return;
}

sub get_path_translated {
    my $self = shift;
    return $self->[REQUEST]->get_path_translated()
        unless $self->[URI];
    return;
}

sub get_query_string {
    my $self = shift;
    return $self->[REQUEST]->get_query_string()
        unless $self->[URI];
    return $self->[URI]->query;
}

package # hide from PAUSE
    JasPerl::RequestDispatcher::IncludeResponseWrapper;

use parent qw(JasPerl::ResponseWrapper);

sub new {
    my ($class, $response) = @_;
    bless \$response, $class;
}

sub get_response {
    return ${$_[0]};
}

sub reset {
    # throw illegal state if committed, ignore otherwise
    if ($_[0]->get_response()->is_committed()) {
        $_[0]->get_response()->reset();
    }
}

sub set_status {
    # ignored
}

sub send_redirect {
    # ignored
}

sub send_error {
    # ignored
}

sub set_header {
    # ignored
}

sub add_header {
    # ignored
}

sub set_content_type {
    # ignored
}

sub set_content_length {
    # ignored
}

sub set_locale {
    # ignored
}

sub add_cookie {
    # ignored
}

1;
